PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/ovract.com/OVRACTM.PAS

Pascal/Delphi Source File | 1989-11-22 | 18.8 KB | 708 lines

{
OVRACTM is a variation on OVRACTR.  This program attempts to show, in a
graphical sort of way, the relationships of the units in the overlay buffer.
You will have to be the judge of just how useful the output of this program is
for your particular application.

Each line of the output represents a change in the contents of the overlay
buffer.  The left-most column shows elapsed program run time in minutes and
seconds.  The rest of the line shows the units in the overlay buffer
as much as possible to scale.  If the name of a unit does not fit
within the space allotted, it is simply truncated.  This is the primary
limitation of this program.  This can be overcome to some degree by specifying
a large width parameter on the command line to increase the number of columns
available.  Monitors that support more than 80 columns can be used to good
advantage here.  Alternatively, the output file can then be viewed using an
editor or file viewer that allows horizontal scrolling.

Except for the addition of the width parameter, OVRACTM is used the same way
as OVRACTR.

Call OVRACTM as follows:

  OVRACTM [Options] [OutputWidth] ProgName [>Output]

OVRACTM forces the extension 'MAP' onto ProgName to find the MAP file, and
the extension 'OVD' onto ProgName to find the overlay data file. The overlay
report is written to the standard output and may be redirected to a file or
to the printer.  The optional width parameter is an integer specifying the
number of columns to be used for the output.  The options are

   /Q   stops OVRACTM from writing status messages while it works.
   /D   produces the detailed report of all overlay activity.
   /S   produces the summary report showing statistics for each unit.
   /O   produces the summary report showing statistics only for overlaid units

Written by Ron Schuster (CIS 76666,2322).  Copyright (c) 1989.
All rights reserved.  May be distributed freely, but not for a profit.

This program was originally based on the overlay profiler OVRPROF
written by Richard Casey (CIS 72247,151).

Portions of this program originally appeared in OVRSIZ by Kim Kokkonen,
TurboPower Software (CIS 76004,2611), and were used with the permission of
the author.  Copyright (c) 1989, TurboPower Software. All rights reserved.
May be distributed freely, but not for a profit.


Version 1.0, 11/21/89
--------------------
  Initial release.
}

{$R-,S-,I-,V-,F-,B-}

program OVRACTM;
  {-Generate reports of overlay activity from data produced by OVRACT}
uses Dos;
const
  Version = '1.0';                {Version number}
  MaxUnits = 255;                 {Maximum number of units to report}
  NameSize = 15;                  {Maximum reported segment name length}
  BufSize = 1024;                 {Size of text I/O buffer}
  ShowStatus : Boolean = True;    {True to keep status running during operation}
  ShowDetail : Boolean = False;   {True to write detailed dump of overlay events}
  ShowSummary : Boolean = False;  {True to write summary report}
  OverlaysOnly : Boolean = False; {True to write summary report with overlaid
                                    units only}
  Digits : array[0..$F] of Char = '0123456789ABCDEF';
  DosDelimSet : set of Char = ['\', ':', #0];
  LeftMargin = 9;                 {Columns used by time in left margin}

type
  UnitNameStr = string[NameSize];
  UnitRecord = record
    Name : UnitNameStr;
    SegClass : Word;
    StatSeg : Word;
    StatLen : LongInt;
    FileOfs : LongInt;
    CodeSize : Word;
    FixupSize : Word;
    EntryPts : Word;
    LoadCount : Word;
    ReprieveCount : Word;
  end;

  Long =
    record
      LowWord, HighWord : Word;
    end;

var
  UnitCount    : Word;
  Units        : array[0..MaxUnits] of UnitRecord;
  StdErr       : text;
  OvrDataFile  : file of Word;
  PSP          : Word;
  Ovr_Heap_Org : Word;
  Ovr_Heap_End : Word;
  Buffer       : array[1..BufSize] of Char; {Text buffer for map file}
  Dname        : PathStr;               {Input OVD file name}
  Mname        : PathStr;               {Input MAP file name}
  Time         : LongInt;
  Width        : Integer;
  OutputLine   : string;
  ParaPerCol   : Real;

procedure WriteCopyRight;
  {-Copyright notice in object code and on screen}
begin
  WriteLn(StdErr, 'TP5.x Overlay Activity Mapper, by Ron Schuster. Version ', Version);
end;

procedure OpenStdErr;
  {-Open standard error device}
begin
  Assign(StdErr, '');
  Rewrite(StdErr);
  with TextRec(StdErr) do begin
    Handle := 2;
    BufSize := 1;
  end;
end;

procedure Error(Msg : String);
  {-Report error and halt}
begin
  if Msg <> '' then
    WriteLn(StdErr, Msg);
  Halt(1);
end;

procedure InvalidMapError;
  {-Common error}
begin
  Error('Invalid MAP file format');
end;

function HexW(W : Word) : String;
  {-Return hex string for word}
begin
  HexW[0] := #4;
  HexW[1] := Digits[Hi(W) shr 4];
  HexW[2] := Digits[Hi(W) and $F];
  HexW[3] := Digits[Lo(W) shr 4];
  HexW[4] := Digits[Lo(W) and $F];
end;

function HexL(L : LongInt) : String;
  {-Return hex string for LongInt}
begin
  with Long(L) do
    HexL := HexW(HighWord)+HexW(LowWord);
end;

function Long2Str(L : LongInt) : String;
  {-Convert a long/word/integer/byte/shortint to a string}
var
  S : String;
begin
  Str(L, S);
  Long2Str := S;
end;

function StUpcase(S : String) : String;
  {-Return the uppercase of a string}
var
  I : Integer;
begin
  for I := 1 to Length(S) do
    S[I] := Upcase(S[I]);
  StUpcase := S;
end;

function StLocase(S : String) : String;
  {-Return the lowercase of a string}
var
  I : Integer;
begin
  for I := 1 to Length(S) do
    if (S[I] >= 'A') and (S[I] <= 'Z') then
      S[I] := chr(ord(S[I])+32);
  StLocase := S;
end;

function PadCh(S : String; Ch : Char; Len : Byte) : String;
  {-Return a string right-padded to length len with ch}
var
  O : String;
begin
  if Length(S) >= Len then
    PadCh := S
  else begin
    O[0] := Chr(Len);
    Move(S[1], O[1], Length(S));
    FillChar(O[Succ(Length(S))], Len-Length(S), Ch);
    PadCh := O;
  end;
end;

function Pad(S : string; Len : Byte) : string;
  {-Return a string right-padded to length len with blanks}
begin
  Pad := PadCh(S, ' ', Len);
end;

function TrimLead(S : String) : String;
  {-Return a string with leading white space removed}
begin
  while (Length(S) > 0) and (S[1] <= ' ') do
    Delete(S, 1, 1);
  TrimLead := S;
end;

function TrimTrail(S : string) : string;
  {-Return a string with trailing white space removed}
var
  SLen : Byte absolute S;
begin
  while (SLen > 0) and (S[SLen] <= ' ') do
    Dec(SLen);
  TrimTrail := S;
end;

function Trim(S : String) : String;
  {-Return a string with leading and trailing white space removed}
begin
  while (Length(S) > 0) and (S[Length(S)] <= ' ') do
    Dec(S[0]);
  while (Length(S) > 0) and (S[1] <= ' ') do
    Delete(S, 1, 1);
  Trim := S;
end;

function GetLong(var S : String; var L : LongInt) : Boolean;
  {-Parse next longint out of line S}
var
  Num : String[8];
  Code : Word;
begin
  S := TrimLead(S);
  Num := '';
  while (Length(S) > 0) and (Pos(S[1], Digits) <> 0) do begin
    Num := Num+S[1];
    Delete(S, 1, 1);
  end;
  if Length(Num) = 0 then begin
    GetLong := False;
    Exit;
  end;
  if (Length(S) > 0) and (Upcase(S[1]) = 'H') then begin
    Num := '$'+Num;
    Delete(S, 1, 1);
  end;
  Val(Num, L, Code);
  GetLong := (Code = 0);
end;

function GetInt(var S : String; var I : Integer) : Boolean;
  {-Parse next integer out of line S}
var
  L : LongInt;
begin
  GetInt := False;
  if not GetLong (S, L) then
    Exit;
  if (L < -MaxInt) or (L > MaxInt) then
    Exit;
  I := L;
  GetInt := True;
end;

function GetName(var S, Name : String) : Boolean;
  {-Parse next alphanumeric name from string s}
begin
  S := TrimLead(S);
  Name := '';
  while (Length(S) > 0) and (S[1] > ' ') do begin
    if Length(Name) < NameSize then
      Name := Name+S[1];
    Delete(S, 1, 1);
  end;
  GetName := (Name <> '');
end;

function HasExtension(Name : String; var DotPos : Word) : Boolean;
  {-Return whether and position of extension separator dot in a pathname}
var
  I : Word;
begin
  DotPos := 0;
  for I := Length(Name) downto 1 do
    if (Name[I] = '.') and (DotPos = 0) then
      DotPos := I;
  HasExtension := (DotPos > 0) and (Pos('\', Copy(Name, Succ(DotPos), 64)) = 0);
end;

function ForceExtension(Name, Ext : String) : String;
  {-Return a pathname with the specified extension attached}
var
  DotPos : Word;
begin
  if HasExtension(Name, DotPos) then
    ForceExtension := Copy(Name, 1, DotPos)+Ext
  else
    ForceExtension := Name+'.'+Ext;
end;

procedure WriteHelp;
  {-Display help information and halt}
begin
  WriteLn;
  WriteLn('Usage: OVRACTM [Options] [OutputWidth] InputName [>OutputFile]');
  WriteLn;
  WriteLn('  OVRACTM must read:');
  WriteLn('    InputName.MAP - symbol file for segment information.');
  WriteLn('    InputName.OVD - overlay data file produced by OVRACT.');
  WriteLn;
  WriteLn('Options:');
  WriteLn('  /Q    Quiet mode. No status output while processing.');
  WriteLn('  /D    Detail report showing all overlay activity.');
  WriteLn('  /S    Summary report showing statistics for each unit.');
  WriteLn('  /O    Summary report showing statistics only for overlaid units.');
  WriteLn;
  WriteLn('  At least one report option must be specified');
  Halt(1);
end;

function ExistFile(FName : String) : Boolean;
  {-Return true if file exists}
var
  F : file;
begin
  Assign(F, FName);
  Reset(F);
  if IoResult = 0 then begin
    ExistFile := True;
    Close(F);
  end else
    ExistFile := False;
end;

procedure ValidateInput;
  {-Get working filenames and assure files exist}
var
  Iroot : PathStr;
  Arg : String;
  I : Integer;
begin
  {Get parameters}
  Width := 79;
  Iroot := '';
  I := 1;
  while I <= ParamCount do begin
    Arg := StUpcase(ParamStr(I));
    if (Arg = '/Q') or (Arg = '-Q') then
      ShowStatus := False
    else if (Arg = '/D') or (Arg = '-D') then
      ShowDetail := True
    else if (Arg = '/S') or (Arg = '-S') then
      ShowSummary := True
    else if (Arg = '/O') or (Arg = '-O') then begin
      ShowSummary := True;
      OverlaysOnly := True;
    end
    else if (Arg[1] in ['0'..'9']) then begin
      if not GetInt (Arg, Width) then
        Error('Invalid numeric argument');
    end
    else if Iroot = '' then
      Iroot := Arg
    else
      Error('Too many filenames on command line');
    Inc(I);
  end;
  if (Iroot = '') or not (ShowDetail or ShowSummary) then
    WriteHelp;

  {Build working filenames}
  Dname := ForceExtension(Iroot, 'OVD');
  Mname := ForceExtension(Iroot, 'MAP');

  {Make sure files are OK}
  if not ExistFile(Dname) then
    Error('OVD file '+Dname+' not found');
  if not ExistFile(Mname) then
    Error('MAP file '+Mname+' not found');

  Width := Width - LeftMargin;
  if (Width < 1) or (Width > 255) then
    Error('Width paramenter out of range');
end;

procedure ParseMapFile(FName : String);
  {-Read and parse the MAP file, guaranteed to exist}
var
  F : Text;
  S : String;
  StatStart : LongInt;
  SegType : String;
  Tlong : LongInt;
  ParseState : (Unknown, Segments, Done);
begin

  {Open up the MAP file for reading}
  Assign(F, FName);
  SetTextBuf(F, Buffer, BufSize);
  Reset(F);
  if IoResult <> 0 then
    Error('Error opening '+FName);

  if ShowStatus then
    WriteLn(StdErr, 'Parsing MAP file');

  {Parse the segment description section only}
  UnitCount := 0;
  ParseState := Unknown;
  repeat
    ReadLn(F, S);
    if IoResult <> 0 then
      Error('Error reading '+FName);
    S := StUpcase(Trim(S));
    if S <> '' then
      if Pos('START', S) = 1 then
        ParseState := Segments
      else if Pos('ADDRESS', S) = 1 then
        ParseState := Done
      else if ParseState = Segments then begin
        {Parse the line to get the unit description}
        Inc(UnitCount);
        if UnitCount > MaxUnits then
          Error('Cannot exceed '+Long2Str(MaxUnits)+' segments');
        FillChar(Units[UnitCount], SizeOf(UnitRecord), 0);

        with Units[UnitCount] do begin

          {Get the position and size of the unit in the EXE image}
          if not GetLong(S, StatStart) then
            InvalidMapError;
          StatSeg := StatStart shr 4;
          {Ignore the end of the segment}
          if not GetLong(S, Tlong) then
            InvalidMapError;
          {Get the length of the segment}
          if not GetLong(S, StatLen) then
            InvalidMapError;

          {Get the name of the segment}
          if not GetName(S, Name) then
            InvalidMapError;
          Name := StLoCase(Name);
          Name[1] := Upcase(Name[1]);

          {Some segments are not really in the EXE file}
          if not GetName(S, SegType) then
            InvalidMapError;
          if SegType = 'CODE' then
            SegClass := 0
          else if SegType = 'DATA' then
            SegClass := 1
          else if SegType = 'STACK' then
            SegClass := 2
          else if SegType = 'HEAP' then
            SegClass := 3
          else
            SegClass := 4;
        end;
      end;
  until (ParseState = Done) or EoF(F);
  Close(F);
end;

function ReadWord : Word;
var
  W : Word;
begin
  if EOF (OvrDataFile) then
    Error ('Unexpected EOF on ' + Dname);
  Read (OvrDataFile, W);
  ReadWord := W;
end;

function LookupSeg (S : Word) : Integer;
var
  I : Integer;
begin
  for I := 1 to UnitCount do
    if (S = Units[I].StatSeg) and (Units[I].StatLen > 0) then begin
      LookUpSeg := I;
      exit;
    end;
  LookUpSeg := 0;
end;

function NextPara(Bytes : LongInt) : LongInt;
  {-Round up to next paragraph}
begin
  NextPara := (Bytes+15) and $FFFFFFF0;
end;

procedure ProcessCodeList;
var
  StaticSeg : Word;
begin
  StaticSeg := ReadWord;
  while StaticSeg <> 0 do begin
    with Units[LookupSeg(StaticSeg)] do begin
      with Long(FileOfs) do begin
        LowWord := ReadWord;
        HighWord := ReadWord;
      end;
      CodeSize := NextPara(ReadWord);
      FixupSize := NextPara(ReadWord);
      EntryPts := ReadWord;
    end;
    StaticSeg := ReadWord;
  end;
end;

function FormatTime (T : LongInt) : string;
const
  Divisor = 119318.0/65536;
var
  Tenths : LongInt;
  Minutes, I : Integer;
  S : string[8];
  Secs : string[3];
begin
  Tenths := Round (T / Divisor);
  Minutes := Tenths div 600;
  Tenths := Tenths mod 600;
  Str (Minutes:3, S);
  Str (Tenths:3, Secs);
  S := S + ':' + Secs;
  for I := 1 to 6 do
    if S[I] = ' ' then
      S[I] := '0';
  Insert ('.',S,7);
  FormatTime := S;
end;

procedure ChangeOverlayBuffer;
begin
  Ovr_Heap_Org := ReadWord;
  Ovr_Heap_End := ReadWord;
  if ShowDetail then begin
    Writeln ('Overlay buffer set to ',HexW(Ovr_Heap_Org),'-',HexW(Ovr_Heap_End));
    ParaPerCol := (Ovr_Heap_End - Ovr_Heap_Org) / Width;
  end;
end;

function SegToCol (S : Word) : Integer;
begin
  SegToCol := Trunc((S - Ovr_Heap_Org)/ParaPerCol);
end;

procedure FormatUnit (StaticSeg,LoadSeg:Word);
var
  I : Integer;
  StartCol : Integer;
  Len : Integer;
  Name : String;
begin
  I := LookupSeg (StaticSeg-PSP-$10);
  StartCol := SegToCol (LoadSeg);
  if I = 0 then begin
    Len := 4;
    Name := HexW (StaticSeg);
  end
  else begin
    Len := SegToCol (LoadSeg + NextPara (Units[I].CodeSize) shr 4) - StartCol;
    if Len < 1 then
      Len := 1;
    Name := PadCh (Units[I].Name,'-',Len);
  end;
  Move (Name[1], OutputLine[StartCol + 1], Len);
end;

procedure PrintLoadList (W : Word);
var
  I : Integer;
  StaticSeg,
  LoadSeg : Word;
  OvrSeg : Word;  { Static segment of unit just loaded }
  OvrOfs : Word;  { Offset of procedure within the unit's static segment }
begin
  OvrSeg := W;
  OvrOfs := ReadWord;
  StaticSeg := ReadWord;
  I := LookupSeg (OvrSeg - PSP - $10);
  with Units[I] do begin
    if ShowDetail then
      OutputLine := Pad ('', Width);
    if StaticSeg = 0 then begin
      { there is no load list, must be a reprieve }
      Inc(ReprieveCount);
      Exit;  { Don't print reprieve events on map }
    end
    else begin
      { load list follows }
      Inc(LoadCount);
      while StaticSeg <> 0 do begin
        LoadSeg := ReadWord;
        if ShowDetail then
          FormatUnit (StaticSeg, LoadSeg);
        StaticSeg := ReadWord;
      end;
    end;
  end;
  if ShowDetail then
    Writeln (FormatTime (Time), ' ', TrimTrail(OutputLine));
end;

procedure ProcessOverlayData (Name : PathStr);
const
  EndListMark : Word = 0;
  OvrHeapMark : Word = $FFFF;
var
  W : Word;
begin
  assign(OvrDataFile,Name);
  {$I-}
  reset(OvrDataFile);
  {$I+}
  if IOResult <> 0 then
    Error ('Could not open '+Name+' for input')
  else begin
    if ShowStatus then
      WriteLn(StdErr, 'Reading OVD file');
    if ReadWord <> 1 then
      Error ('OVD file version mismatch');
    PSP := ReadWord;
    ProcessCodeList;
    while not EOF (OvrDataFile) do begin
      with Long(Time) do begin
        LowWord := ReadWord;
        HighWord := ReadWord;
      end;
      W := ReadWord;
      if W = OvrHeapMark then begin
        ChangeOverlayBuffer;
        W := ReadWord;
      end;
      PrintLoadList (W);
    end;
  end;
end;

procedure WriteUnitInfo;
var
  V : Word;
begin
  WriteLn;
  WriteLn(
'UNIT STATISTICS');
  WriteLn(
'                Static  Static  Overlay  Fixup   Entry  Overlay  Load  Reprieve');
  WriteLn(
'Segment name   Segment    Size    Size    Size  Points  FilePos  Count  Count');
  WriteLn(
'==============  ======   =====   =====   =====   =====  =======  =====  =====');
{xxxxxxxxxxxxxxx 0FFFFh   ddddd   ddddd   ddddd   ddddd  0FFFFFh  ddddd  ddddd}

  for V := 1 to UnitCount do
    with Units[V] do
      if (StatLen > 0) and (not OverlaysOnly or (CodeSize > 0)) then begin
        Write(Pad(Name, NameSize+1),
              '0', HexW(StatSeg), 'h   ',
              StatLen:5, '   ');

        if CodeSize > 0 then begin
          { Overlaid Unit }
          Write(CodeSize:5, '   ',
                FixupSize:5, '   ',
                EntryPts:5, '  ',
                Copy(HexL(FileOfs), 3, 6), 'h  ',
                LoadCount:5, '  ',
                ReprieveCount:5);

        end else begin
          {Non-overlaid unit or other segment}
          Write('    -       -       -        -      -      -');
        end;
        WriteLn;
      end;
end;

begin
  {Open standard error device}
  OpenStdErr;

  {Display copyright}
  WriteCopyRight;

  {Get filenames and assure they exist}
  ValidateInput;

  {Parse MAP file to get segment names and locations}
  ParseMapFile(Mname);

  {Read overlay data file}
  ProcessOverlayData(Dname);

  {Write information}
  if ShowSummary then
    WriteUnitInfo;
end.